home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok54 / mastermind / mastermind.mod < prev    next >
Text File  |  1993-11-04  |  10KB  |  378 lines
  1. (*********************************************************************
  2.   :Program.    MasterMind.mod
  3.   :Contents.   the game, I suppose, anyone knows
  4.   :Author.     Thomas Berndt
  5.   :Copyright.  PD
  6.   :Language.   Modula-2
  7.   :Translator. M2Amiga AMSoft V3.3d
  8.   :History.    02-91 Thomas Berndt
  9.   :Address.    Neckarhauserstr. 94 6800 Mannheim-71
  10.   :Imports.    BeamRandom AMOK#20
  11. *********************************************************************)
  12.  
  13. MODULE MasterMind ;
  14. (* $V- $S-  $F- $P- $R- *)
  15. FROM Arts       IMPORT AllLevelTermProc ;
  16. FROM BeamRandom IMPORT RND ;
  17. FROM Exec       IMPORT WaitPort,GetMsg,ReplyMsg ;
  18. FROM Graphics   IMPORT ViewModes,ViewModeSet,DrawModes,DrawModeSet,
  19.                        RastPortPtr,Move,Draw,Text,SetAPen,SetBPen,
  20.                        RectFill,DrawEllipse,SetRGB4,SetRast ;
  21. FROM Intuition  IMPORT NewScreen,ScreenPtr,ScreenFlags,ScreenFlagSet,
  22.                        customScreen,OpenScreen,CloseScreen,
  23.                        NewWindow,WindowPtr,WindowFlags,WindowFlagSet,
  24.                        OpenWindow,CloseWindow,IDCMPFlags,IDCMPFlagSet,
  25.                        IntuiMessagePtr,Gadget,GadgetFlags,GadgetFlagSet,
  26.                        ActivationFlags,ActivationFlagSet ;
  27. FROM SYSTEM     IMPORT ADR,ADDRESS ;
  28.  
  29. TYPE
  30.   Code                  = ARRAY [0..6] OF INTEGER ;
  31.  
  32. VAR
  33.   Scr                   : ScreenPtr ;
  34.   Win                   : WindowPtr ;
  35.   rpp                   : RastPortPtr ;
  36.   Msg                   : IntuiMessagePtr ;
  37.   Class                 : IDCMPFlagSet ;
  38.   Addr                  : ADDRESS ;
  39.   OKGad,ShowGad,EndGad  : Gadget ;
  40.   lap,color,PosOK,ColOK,
  41.   x,y,i,j               : INTEGER ;
  42.   Combination,Copy,
  43.   Player                : Code ;
  44.   closed                : BOOLEAN ;
  45.  
  46. PROCEDURE Close ;
  47. BEGIN
  48.   IF Win#NIL THEN
  49.     CloseWindow(Win) ;
  50.   END ; (* IF *)
  51.   IF Scr#NIL THEN
  52.     CloseScreen(Scr) ;
  53.   END ; (* IF *)
  54. END Close ;
  55.  
  56. PROCEDURE Box(x1,y1,x2,y2 : INTEGER) ;
  57. BEGIN
  58.   Move(rpp,x1,y1) ;
  59.   Draw(rpp,x2,y1) ;
  60.   Draw(rpp,x2,y2) ;
  61.   Draw(rpp,x1,y2) ;
  62.   Draw(rpp,x1,y1) ;
  63. END Box ;
  64.  
  65. PROCEDURE Build ;
  66. VAR
  67.   NuScr         : NewScreen ;
  68.   NuWin         : NewWindow ;
  69. BEGIN
  70.   WITH NuScr DO
  71.     leftEdge  := 0     ; topEdge  := 0 ;
  72.     width     := 320   ; height   := 256 ;
  73.     depth     := 4     ; detailPen := 0 ;
  74.     blockPen  := 1     ; viewModes := ViewModeSet{} ;
  75.     type      := customScreen ;
  76.     font      := NIL ;
  77.     defaultTitle := ADR("MasterMind") ;
  78.     gadgets := NIL     ; customBitMap := NIL ;
  79.   END ; (* WITH *)
  80.   Scr := OpenScreen(NuScr) ;
  81.   WITH OKGad DO
  82.     nextGadget := ADR(ShowGad) ;
  83.     leftEdge := 193 ;
  84.     topEdge := 176 ;
  85.     width := 31 ;
  86.     height := 11 ;
  87.     flags := GadgetFlagSet{} ;
  88.     activation := ActivationFlagSet{relVerify,gadgImmediate} ;
  89.     gadgetType := 1 ;
  90.     gadgetRender := NIL ;
  91.     selectRender := NIL ;
  92.     gadgetText := NIL ;
  93.   END ; (* WITH *)
  94.   WITH ShowGad DO
  95.     nextGadget := ADR(EndGad) ;
  96.     leftEdge := 241 ;
  97.     topEdge := 176 ;
  98.     width := 55 ;
  99.     height := 11 ;
  100.     flags := GadgetFlagSet{} ;
  101.     activation := ActivationFlagSet{relVerify,gadgImmediate} ;
  102.     gadgetType := 1 ;
  103.     gadgetRender := NIL ;
  104.     selectRender := NIL ;
  105.     gadgetText := NIL ;
  106.   END ; (* WITH *)
  107.   WITH EndGad DO
  108.     nextGadget := NIL ;
  109.     leftEdge := 220 ;
  110.     topEdge := 198 ;
  111.     width := 47 ;
  112.     height := 11 ;
  113.     flags := GadgetFlagSet{} ;
  114.     activation := ActivationFlagSet{relVerify,gadgImmediate} ;
  115.     gadgetType := 1 ;
  116.     gadgetRender := NIL ;
  117.     selectRender := NIL ;
  118.     gadgetText := NIL ;
  119.   END ; (* WITH *)
  120.   WITH NuWin DO
  121.     leftEdge    := 0     ; topEdge := 11 ;
  122.     width       := 320    ; height := 245 ;
  123.     detailPen   := 0      ; blockPen := 1 ;
  124.     idcmpFlags  := IDCMPFlagSet{mouseButtons,gadgetUp} ;
  125.     flags       := WindowFlagSet{borderless} ;
  126.     firstGadget := ADR(OKGad) ;
  127.     checkMark := NIL ;
  128.     title       := NIL ;
  129.     screen      := Scr ;
  130.     bitMap      := NIL    ; type := customScreen ;
  131.     minWidth   := 100     ; maxWidth := 320 ;
  132.     minHeight  := 20      ; maxHeight := 245 ;
  133.   END ; (* WITH *)
  134.   Win := OpenWindow(NuWin) ;
  135.   rpp := Win^.rPort ;
  136.   SetRGB4(ADR(Scr^.viewPort),0,3,7,6) ;    (* blau-grün *)
  137.   SetRGB4(ADR(Scr^.viewPort),2,6,4,13) ;   (* blau *)
  138.   SetRGB4(ADR(Scr^.viewPort),3,15,0,0) ;   (* rot *)
  139.   SetRGB4(ADR(Scr^.viewPort),4,2,13,3) ;   (* grün *)
  140.   SetRGB4(ADR(Scr^.viewPort),5,12,8,0) ;   (* braun *)
  141.   SetRGB4(ADR(Scr^.viewPort),6,12,1,15) ;  (* lila *)
  142.   SetRGB4(ADR(Scr^.viewPort),7,15,15,0) ;  (* gelb *)
  143.   SetAPen(rpp,1) ;
  144.   Box(5,20,160,160) ;
  145.   Box(30,30,50,150) ;
  146.   Box(29,29,51,151) ;
  147.   Move(rpp,40,30) ;
  148.   Draw(rpp,40,150) ;
  149.   Box(60,30,140,150) ;
  150.   Box(59,29,141,151) ;
  151.   FOR i := 0 TO 5 DO
  152.     Move(rpp,30,30+i*20) ;
  153.     Draw(rpp,50,30+i*20) ;
  154.     Move(rpp,30,29+i*20) ;
  155.     Draw(rpp,50,29+i*20) ;
  156.     Move(rpp,30,40+i*20) ;
  157.     Draw(rpp,50,40+i*20) ;
  158.     Move(rpp,60,30+i*20) ;
  159.     Draw(rpp,140,30+i*20) ;
  160.     Move(rpp,60,29+i*20) ;
  161.     Draw(rpp,140,29+i*20) ;
  162.     Move(rpp,5+i*25,190) ;
  163.     Draw(rpp,5+i*25,210) ;
  164.     SetAPen(rpp,2+i) ;
  165.     RectFill(rpp,7+i*25,192,28+i*25,208) ;
  166.     SetAPen(rpp,1) ;
  167.   END ; (* FOR *)
  168.   FOR i := 0 TO 3 DO
  169.     DrawEllipse(rpp,210+i*20,120,7,7) ;
  170.     Move(rpp,200+i*20,110) ;
  171.     Draw(rpp,200+i*20,130) ;
  172.     Move(rpp,60+i*20,30) ;
  173.     Draw(rpp,60+i*20,150) ;
  174.     FOR j := 0 TO 5 DO
  175.       DrawEllipse(rpp,70+i*20,40+j*20,7,7) ;
  176.     END ; (* FOR *)
  177.   END ; (* FOR *)
  178.   Move(rpp,56,184) ;
  179.   Text(rpp,ADR("Farben"),6) ;
  180.   Box(5,190,155,210) ;
  181.   Move(rpp,200,48) ;
  182.   Text(rpp,ADR("MasterMind"),10) ;
  183.   Move(rpp,184,64) ;
  184.   Text(rpp,ADR("von Th. Berndt"),14) ;
  185.   Move(rpp,196,96) ;
  186.   Text(rpp,ADR("Kombination"),11) ;
  187.   Box(200,110,280,130) ;
  188.   Move(rpp,200,184) ;
  189.   Text(rpp,ADR("OK"),2) ;
  190.   Box(192,175,224,187) ;
  191.   Move(rpp,248,184) ;
  192.   Text(rpp,ADR("Zeige"),5) ;
  193.   Box(240,175,296,187) ;
  194.   Move(rpp,228,206) ;
  195.   Text(rpp,ADR("Ende"),4) ;
  196.   Box(219,197,267,209) ;
  197. END Build ;
  198.  
  199. PROCEDURE Clear ;
  200. BEGIN
  201.   SetAPen(rpp,0) ;
  202.   RectFill(rpp,31,31,49,149) ;
  203.   SetAPen(rpp,1) ;
  204.   Move(rpp,40,30) ;
  205.   Draw(rpp,40,150) ;
  206.   FOR i := 0 TO 5 DO
  207.     SetAPen(rpp,0) ;
  208.     RectFill(rpp,61,31+i*20,139,48+i*20) ;
  209.     FOR j := 0 TO 3 DO
  210.       SetAPen(rpp,1) ;
  211.       DrawEllipse(rpp,70+j*20,40+i*20,7,7) ;
  212.       Move(rpp,60+j*20,30+i*20) ;
  213.       Draw(rpp,60+j*20,49+i*20) ;
  214.       SetAPen(rpp,0) ;
  215.       DrawEllipse(rpp,210+j*20,120,5,i) ;
  216.     END ; (* FOR *)
  217.     SetAPen(rpp,1) ;
  218.     Move(rpp,30,30+i*20) ;
  219.     Draw(rpp,50,30+i*20) ;
  220.     Move(rpp,30,29+i*20) ;
  221.     Draw(rpp,50,29+i*20) ;
  222.     Move(rpp,30,40+i*20) ;
  223.     Draw(rpp,50,40+i*20) ;
  224.   END ; (* FOR *)
  225. END Clear ;
  226.  
  227. PROCEDURE Show ;
  228. BEGIN
  229.   FOR i := 0 TO 3 DO
  230.     SetAPen(rpp,Combination[i]+2) ;
  231.     FOR j := 0 TO 5 DO
  232.       DrawEllipse(rpp,210+i*20,120,5,j) ;
  233.     END ; (* FOR *)
  234.   END ; (* FOR *)
  235.   REPEAT
  236.     WaitPort(Win^.userPort) ;
  237.     Msg := GetMsg(Win^.userPort) ;
  238.     Class := Msg^.class ;
  239.     Addr := Msg^.iAddress ;
  240.     ReplyMsg(Msg) ;
  241.   UNTIL Addr=ADR(OKGad) ;
  242. END Show ;
  243.  
  244. PROCEDURE Ziehe ;
  245. BEGIN
  246.   FOR i := 0 TO 3 DO
  247.     Combination[i] := RND(6) ;
  248.     j := 0 ;
  249.     WHILE j<i DO
  250.       IF Combination[i]=Combination[j] THEN
  251.         Combination[i] := RND(6) ;
  252.         j := 0 ;
  253.       ELSE
  254.         INC(j) ;
  255.       END ; (* IF *)
  256.     END ; (* WHILE *)
  257.   END ; (* FOR *)
  258. END Ziehe ;
  259.  
  260. PROCEDURE Check ;
  261. BEGIN
  262.   Copy := Combination ;
  263.   PosOK := 0 ;
  264.   ColOK := 0 ;
  265.   FOR i := 0 TO 3 DO
  266.     IF Copy[i]=Player[i] THEN
  267.       INC(PosOK) ;
  268.       Copy[i] := -1 ;
  269.       Player[i] := -2 ;
  270.     END ; (* IF *)
  271.   END ; (* FOR *)
  272.   SetAPen(rpp,8) ;
  273.   FOR i := 0 TO PosOK-1 DO
  274.     IF i<2 THEN
  275.       FOR j := 0 TO 3 DO
  276.         DrawEllipse(rpp,35+i*10,35+lap*20,3,j) ;
  277.       END ; (* FOR *)
  278.     ELSE
  279.       FOR j := 0 TO 3 DO
  280.         DrawEllipse(rpp,35+(i-2)*10,45+lap*20,3,j) ;
  281.       END ; (* FOR *)
  282.     END ; (* IF *)
  283.   END ; (* FOR *)
  284.   IF PosOK#4 THEN
  285.     FOR i := 0 TO 3 DO
  286.       FOR j := 0 TO 3 DO
  287.         IF Copy[i]=Player[j] THEN
  288.           INC(ColOK) ;
  289.         END ; (* IF *)
  290.       END ; (* FOR *)
  291.     END ; (* FOR *)
  292.     SetAPen(rpp,1) ;
  293.     FOR i := PosOK TO PosOK+ColOK-1 DO
  294.       IF i<2 THEN
  295.         FOR j := 0 TO 3 DO
  296.           DrawEllipse(rpp,35+i*10,35+lap*20,3,j) ;
  297.         END ; (* FOR *)
  298.       ELSE
  299.         FOR j := 0 TO 3 DO
  300.           DrawEllipse(rpp,35+(i-2)*10,45+lap*20,3,j) ;
  301.         END ; (* FOR *)
  302.       END ; (* IF *)
  303.     END ; (* FOR *)
  304.     SetAPen(rpp,color) ;
  305.   ELSE
  306.     lap := 6 ;
  307.     Show ;
  308.   END ; (* IF *)
  309.   FOR i := 0 TO 3 DO
  310.     Player[i] := -1 ;
  311.   END ; (* FOR *)
  312. END Check ;
  313.  
  314. PROCEDURE SetColor ;
  315. BEGIN
  316.   x := Win^.mouseX ;
  317.   y := Win^.mouseY ;
  318.   IF (y>lap*20+30) AND (y<lap*20+50) THEN
  319.     FOR i := 0 TO 3 DO
  320.       IF (x>60+i*20) AND (x<80+i*20) THEN
  321.         FOR j := 0 TO 5 DO
  322.           DrawEllipse(rpp,70+i*20,40+lap*20,j,5) ;
  323.         END ; (* FOR *)
  324.         Player[i] := color ;
  325.       END ; (* IF *)
  326.     END ; (* FOR *)
  327.   ELSIF (y>190) AND (y<210) THEN
  328.     FOR i := 0 TO 5 DO
  329.       IF (x>5+i*25) AND (x<30+i*25) THEN
  330.         color := i ;
  331.         SetAPen(rpp,2+color) ;
  332.       END ; (* IF *)
  333.     END ; (* FOR *)
  334.   END ; (* IF *)
  335.   IF lap=6 THEN
  336.     Show ;
  337.   END ; (* IF *)
  338. END SetColor ;
  339.  
  340. BEGIN
  341.   AllLevelTermProc(Close) ;
  342.   Build ;
  343.   closed := FALSE ;
  344.   color := -1 ;
  345.   REPEAT
  346.     Ziehe ;
  347.     lap := 0 ;
  348.     SetAPen(rpp,2) ;
  349.     WHILE lap<6 DO
  350.       WaitPort(Win^.userPort) ;
  351.       Msg := GetMsg(Win^.userPort) ;
  352.       IF Msg#NIL THEN
  353.         Class := Msg^.class ;
  354.         Addr := Msg^.iAddress ;
  355.         ReplyMsg(Msg) ;
  356.         IF (mouseButtons IN Class) THEN
  357.           SetColor ;
  358.         ELSIF (closeWindow IN Class) THEN
  359.           lap := 7 ;
  360.           closed := TRUE ;
  361.         ELSIF (gadgetUp IN Class) THEN
  362.           IF Addr=ADR(OKGad) THEN
  363.             Check ;
  364.             INC(lap) ;
  365.           ELSIF Addr=ADR(ShowGad) THEN
  366.             lap := 7 ;
  367.             Show ;
  368.           ELSIF Addr=ADR(EndGad) THEN
  369.             lap := 7 ;
  370.             closed := TRUE ;
  371.           END ; (* IF *)
  372.         END ; (* IF *)
  373.       END ; (* IF *)
  374.     END ; (* WHILE *)
  375.     Clear ;
  376.   UNTIL closed ;
  377. END MasterMind .
  378.